home *** CD-ROM | disk | FTP | other *** search
/ The X-Philes (2nd Revision) / The X-Philes Number 1 (1995).iso / xphiles / hp48hor1 / nav4.src < prev    next >
Text File  |  1991-05-29  |  22KB  |  1,319 lines
  1. %%HP: T(3)A(D)F(.);
  2. @ NAV4, Celestial Navigation, by Tom Metcalf
  3. DIR
  4.   SOLVE
  5.     \<< SAVES FFIX
  6. DEG 0 0 0 0 0 GSUM
  7. a0 \->NUM 'A0' STO a1
  8. \->NUM 'A1' STO EV1
  9. \->NUM DUP '\Ga1' STO
  10. EIGEN 'E1' STO EV3
  11. \->NUM DUP '\Ga3' STO
  12. EIGEN 'E3' STO EV2
  13. \->NUM DUP '\Ga2' STO
  14. EIGEN 'E2' STO R E1
  15. DOT '\Gb1' STO
  16.       IF '\Ga1==0 AND
  17. \Gb1==0'
  18.       THEN
  19. "AMBIGUOUS SOLUTION"
  20. MESS KILL
  21.       END R E2 DOT
  22. '\Gb2' STO R E3 DOT
  23. '\Gb3' STO 'G\Gm' '\Gm' {
  24. \GmST LBND UBND }
  25. ROOT DROP
  26.       IF '\Gm>\Ga1 OR \Gm
  27. <LBND'
  28.       THEN
  29. "ROOT ERROR"
  30.       END UVW OUT
  31. CLLCD "Update DR?"
  32. 2 DISP DUP2 \->STR 4
  33. DISP \->STR 5 DISP
  34. ASK
  35.       IF 11.1 ==
  36.       THEN DUP2
  37. FMT\-> 'DRLAT' STO
  38. FMT\-> 'DRLON' STO
  39.       END RESTS
  40. RESTS
  41.     \>>
  42.   ADDOB
  43.     \<< SAVES DEG
  44. RCLMENU 28 MENU \->
  45. om
  46.       \<<
  47. "Time/Altitude
  48. (hh.mmss)/"
  49. FMT +
  50. ":Time: 
  51. :H_s: " {
  52. 1 0 } 'V' 3 \->LIST
  53. INPUT OBJ\-> DTAG
  54. SWAP DTAG SWAP 0 \->
  55. TM A n
  56.         \<< TM HMS\->
  57. 'TM' STO
  58.           IF TM T1
  59. < TM T2 > BODY "T"
  60. SAME NOT AND OR
  61.           THEN
  62. "Error:Bad Time
  63. Press ENTER"
  64. MESS om MENU KILL
  65.           END A
  66. CORRECT FMT\-> 'A'
  67. STO TM GHA1 GHA2
  68. INTERP 180 RANGE TM
  69. DEC1 DEC2 INTERP
  70.           IF 'SPD\=/0
  71. '
  72.           THEN TF
  73. TM - SPD * 60 / CRS
  74. RMOVE SWAP 180
  75. RANGE SWAP
  76.           END OBS
  77.           IFERR
  78. OBJ\->
  79.           THEN 3
  80. ROLLD A { 1 3 }
  81. \->ARRY SWAP STO
  82.           ELSE OBJ\->
  83. ROT 1 + DUP 3 * 'n'
  84. STO ROT ROT \->LIST n
  85. ROLL n ROLL ROT A
  86. SWAP \->ARRY 'OBS'
  87. STO
  88.           END
  89.         \>> om MENU
  90.       \>> RESTS
  91.     \>>
  92.   SETUP
  93.     \<< RCLMENU 28
  94. MENU \-> om
  95.       \<< FFIX CLLCD
  96. 2 FREEZE MBODY
  97. TMENU "BODY?"
  98. PROMPT 'BODY' STO 0
  99. MENU
  100.         IF BODY "S"
  101. SAME
  102.         THEN
  103.           DO
  104. "SEMI-D? " FMT + SD
  105. \->FMT \->STR 'V' 2
  106. \->LIST INPUT OBJ\->
  107. FMT\-> 'SEMI' STO
  108.             IF '
  109. SEMI>.55'
  110.             THEN
  111. "TOO LARGE:PRESS ENTER"
  112. MESS
  113.             END
  114.           UNTIL '
  115. SEMI\<=.55'
  116.           END
  117.         END
  118.         IF BODY "M"
  119. SAME BODY "VM" SAME
  120. OR
  121.         THEN
  122.           DO
  123. "HParallax? " FMT +
  124. HP \->FMT \->STR 'V' 2
  125. \->LIST INPUT OBJ\->
  126. FMT\-> 'HP' STO
  127.             IF 'HP>
  128. 1.2'
  129.             THEN
  130. "TOO LARGE:PRESS ENTER"
  131. MESS
  132.             END
  133.           UNTIL 'HP
  134. <1.2'
  135.           END
  136.         END
  137.         IF BODY "M"
  138. SAME BODY "S" SAME
  139. OR
  140.         THEN CLLCD
  141. 2 FREEZE MLIMB
  142. TMENU "Limb?"
  143. PROMPT 'LU' STO 0
  144. MENU
  145.         END
  146.         DO
  147.           IF BODY
  148. "T" SAME
  149.           THEN
  150. "Star" ":GHA\Gg: " G\Gg
  151. \->FMT \->STR +
  152. "
  153. :SHA: 
  154. :DEC: 
  155. " +
  156. ":TIM: " T\Gg \->HMS
  157. \->STR + + { 1 0 }
  158. 'V' 3 \->LIST INPUT
  159. OBJ\-> HMS\-> DUP 'T1'
  160. STO DUP 'T\Gg' STO 1
  161. + 'T2' STO FMT\-> DUP
  162. 'DEC1' STO 'DEC2'
  163. STO FMT\-> SWAP FMT\->
  164. DUP 'G\Gg' STO + DUP
  165. 'GHA1' STO
  166. 15.041067 + 'GHA2'
  167. STO
  168.           ELSE
  169. "Linear Interp 1" {
  170. ":GHA1: 
  171. :DEC1: 
  172. :TIM1: "
  173. { 1 0 } V } INPUT
  174. OBJ\-> HMS\-> 'T1' STO
  175. FMT\-> 'DEC1' STO
  176. FMT\-> 'GHA1' STO
  177. "Linear Interp 2" {
  178. ":GHA2: 
  179. :DEC2: 
  180. :TIM2: "
  181. { 1 0 } V } INPUT
  182. OBJ\-> HMS\-> 'T2' STO
  183. FMT\-> 'DEC2' STO
  184. FMT\-> 'GHA2' STO
  185.           END
  186.           IF 'T1\>=T2
  187. '
  188.           THEN
  189. "Err:T1\>=T2:Press ENTER"
  190. MESS
  191.           END
  192.           IF 'GHA1>
  193. GHA2'
  194.           THEN
  195. "GHA1>GHA2:Hit ENTER"
  196. MESS
  197.           END
  198.         UNTIL 'T1<
  199. T2 AND GHA1\<=GHA2'
  200.         END
  201.         IF 'SPD\=/0'
  202.         THEN DR 4
  203. FIX
  204. "TIME OF FIX? (hms)"
  205. TF \->HMS \->STR 'V' 2
  206. \->LIST INPUT OBJ\->
  207. HMS\-> 'TF' STO FFIX
  208.         END om MENU
  209.       \>>
  210.     \>>
  211.   INIT
  212.     \<< RCLMENU 28
  213. MENU \-> om
  214.       \<< FFIX { {
  215. "INDEX" {
  216.         \<< 0 MENU
  217. "INDEX? " FMT +
  218. INDX \->FMT "INDEX"
  219. \->TAG \->STR { 1 0 }
  220. 'V' 3 \->LIST INPUT
  221. OBJ\-> FMT\-> 'INDX'
  222. STO 0 CONT
  223.         \>> } } {
  224. "HEIGHT" {
  225.         \<< 0 MENU
  226. "HEIGHT? (m)" HGT
  227. "HGT" \->TAG \->STR { 1
  228. 0 } 'V' 3 \->LIST
  229. INPUT OBJ\-> '1_m'
  230. DOUNIT 'HGT' STO 0
  231. CONT
  232.         \>> } } {
  233. "C/S" {
  234.         \<< 0 MENU
  235. "Motion? (True/Knots)"
  236. ":COURSE: " CRS
  237. \->FMT \->STR +
  238. "
  239. :SPEED: " SPD
  240. \->STR + + { 1 0 }
  241. 'V' 3 \->LIST INPUT
  242. OBJ\-> '1_knot'
  243. DOUNIT 'SPD' STO
  244. FMT\-> 180 RANGE
  245. 'CRS' STO 0 CONT
  246.         \>> } } {
  247. "P/T" {
  248.         \<< 0 MENU
  249. "ENTER for std cond"
  250. {
  251. ":PRESS (mb): 1010
  252. :TEMPER (C): 10"
  253. -14 V } INPUT OBJ\->
  254. '1_\^oC' DOUNIT
  255. 'TMPTR' STO '1_mbar
  256. ' DOUNIT 'PRESS'
  257. STO 0 CONT
  258.         \>> } } {
  259. "FORMAT" {
  260.         \<< 0 MENU
  261. FFMT 1 +
  262.           IF DUP 3
  263. ==
  264.           THEN DROP
  265. 0
  266.           END
  267. 'FFMT' STO
  268.           CASE '
  269. FFMT==2'
  270.             THEN
  271. "(decimal)"
  272.             END '
  273. FFMT==1'
  274.             THEN
  275. "(dd.mmt)"
  276.             END '
  277. FFMT==0'
  278.             THEN
  279. "(dd.mmss)"
  280.             END
  281.           END 'FMT'
  282. STO FFIX 0 CONT
  283.         \>> } } {
  284. "EXIT" {
  285.         \<< 1 CONT
  286.         \>> } } }
  287. TMENU
  288.         DO CLLCD
  289. "INDEX  " INDX \->FMT
  290. \->STR + 2 DISP
  291. "HEIGHT " HGT \->STR
  292. "m" + + 3 DISP 1
  293. FIX "MOTION " CRS
  294. \->FMT \->STR + "T " +
  295. SPD \->STR + "kn" + 4
  296. DISP "P/T    "
  297. PRESS \->STR "mb " +
  298. TMPTR \->STR + "C" +
  299. + 5 DISP FFIX
  300. "FORMAT "
  301.           CASE '
  302. FFMT==2'
  303.             THEN
  304. "Decimal"
  305.             END '
  306. FFMT==1'
  307.             THEN
  308. "HMT"
  309.             END '
  310. FFMT==0'
  311.             THEN
  312. "HMS"
  313.             END "?"
  314.           END + 6
  315. DISP 3 FREEZE HALT
  316. 0 MENU
  317.         UNTIL
  318.         END om MENU
  319.       \>>
  320.     \>>
  321.   ADDDR
  322.     \<< SAVES 0
  323. RCLMENU 28 MENU \-> n
  324. om
  325.       \<< OBS
  326.         IFERR OBJ\->
  327.         THEN DROP 0
  328.         ELSE OBJ\->
  329. DROP DROP
  330.         END 'n' STO
  331. FMT DRLAT \->FMT
  332. "DR_LAT" \->TAG \->STR
  333. "
  334. " + DRLON \->FMT
  335. "DR_LON" \->TAG \->STR
  336. + { 1 0 } 'V' 3
  337. \->LIST 28 MENU INPUT
  338. 0 MENU OBJ\-> DTAG
  339. FMT\-> SWAP DTAG FMT\->
  340. 90 n 1 + 3 2 \->LIST
  341. \->ARRY 'OBS' STO om
  342. MENU
  343.       \>> RESTS
  344.     \>>
  345.   DR
  346.     \<< RCLMENU 28
  347. MENU \-> om
  348.       \<< FFIX
  349. "Dead Reckoning? 
  350. "
  351. FMT + DRLAT \->FMT
  352. "DR_LAT" \->TAG \->STR
  353. "
  354. " + DRLON \->FMT
  355. "DR_LON" \->TAG \->STR
  356. + { 1 0 } 'V' 3
  357. \->LIST INPUT OBJ\->
  358. FMT\-> 'DRLON' STO
  359. FMT\-> 'DRLAT' STO om
  360. MENU
  361.       \>>
  362.     \>>
  363.   PLOTP
  364.     \<< SAVES DEG
  365.       IF DEPTH 2 <
  366.       THEN
  367. "LON/LAT NOT ON STACK"
  368. MESS KILL
  369.       END 2 DUPN
  370. FMT\-> 'LAT' STO FMT\->
  371. 'LON' STO 0 0 0 0 0
  372. 0 0 0 0 0 0 0 0 0 0
  373. \-> g d a l n N sc
  374. sc\Gl ssz d0 d1 ll lm
  375. top bot
  376.       \<<
  377. "Scale? (NMiles)" {
  378. "9" -1 V } INPUT
  379. OBJ\-> ABS '1_nmi'
  380. DOUNIT
  381.         IF DUP 0 ==
  382.         THEN DROP
  383. "SCALE\=/0 PLEASE"
  384. MESS KILL
  385.         END 120 /
  386. DUP 'sc' STO LAT
  387. COS / 2.0469 * 180
  388. MIN NEG 'sc\Gl' STO
  389. ERASE { # 0h # 0h }
  390. PVIEW LON sc\Gl + LON
  391. RANGE LAT sc + 90
  392. MIN DUP 'top' STO
  393. DUP 3 ROLLD R\->C
  394. PMAX LON sc\Gl - LON
  395. RANGE LAT sc - -90
  396. MAX DUP 'bot' STO
  397. DUP 3 ROLLD R\->C
  398. PMIN - 2 / 'sc' STO
  399. OBS OBJ\-> OBJ\-> DROP2
  400. DUP 'N' STO 3 *
  401. DROPN 1 N
  402.         FOR n DEPTH
  403. 'd0' STO OBS { n 1
  404. } GET 'g' STO OBS {
  405. n 2 } GET 'd' STO
  406. OBS { n 3 } GET 'a'
  407. STO
  408.           IF 'LAT-
  409. sc>d+90-a OR LAT+sc
  410. <d-90+a'
  411.           THEN
  412.           ELSE top
  413. d 90 a - +
  414.             IF DUP
  415. 90 >
  416.             THEN
  417. 180 SWAP -
  418.             END MIN
  419. bot d 90 a - -
  420.             IF DUP
  421. -90 <
  422.             THEN
  423. 180 + NEG
  424.             END MAX
  425.             IF LAT
  426. d <
  427.             THEN
  428. SWAP
  429.             END
  430. DUP2 SWAP - DUP
  431. SIGN
  432.             IF DUP
  433. 0 ==
  434.             THEN
  435. DROP 1
  436.             END
  437. SWAP ABS 90 a -
  438. PSCALE sc 32 / MAX
  439. * 'ssz' STO DUP
  440. 'lm' STO SWAP DUP
  441. 'll' STO - ssz /
  442. CEIL 0 SWAP
  443.             FOR l g
  444. d a l ssz * ll +
  445. DUP lm
  446.               IF '
  447. ssz<0'
  448.               THEN
  449. SWAP
  450.               END
  451.               IF >
  452.               THEN
  453. DROP lm
  454.               END
  455. LOP DUP C\->R SWAP g
  456. - NEG g + LON RANGE
  457. SWAP R\->C DEPTH d0 -
  458. ROLLD
  459.             NEXT
  460. DEPTH d0 - 2 / 2 +
  461. 'd1' STO
  462.             WHILE
  463. DEPTH d0 - DUP 1 >
  464.             REPEAT
  465.               IF d1
  466. \=/
  467.               THEN
  468. OVER SWAP
  469.               END
  470. LIMIT LINE
  471.             END
  472. DEPTH d0 - DROPN
  473.           END
  474.         NEXT LAT
  475. COS DUP LON
  476. .0083333 ROT / -
  477. LAT R\->C SWAP LON
  478. .0083333 ROT / +
  479. LAT R\->C LINE LON
  480. LAT .0083333 - R\->C
  481. LON LAT .0083333 +
  482. R\->C LINE
  483.       \>> { } PVIEW
  484. RESTS
  485.     \>>
  486.   ADV
  487.     \<< SAVES DEG
  488. RCLMENU 28 MENU \->
  489. om
  490.       \<< 0 0 0 0 0 0
  491. \-> \Gh d \Gl l n n3
  492.         \<<
  493. "Motion? (nmi,deg true)"
  494. {
  495. ":DISTANCE: 
  496. :COURSE: "
  497. { 1 0 } V } INPUT
  498. OBJ\-> FMT\-> 180 RANGE
  499. '\Gh' STO '1_nmi'
  500. DOUNIT
  501.           IF 'SPD\=/0
  502. '
  503.           THEN DUP
  504. SPD / 'TF' STO+
  505.           END 60 /
  506. 'd' STO 2 FIX CLLCD
  507. "Old DR: " DRLAT
  508. \->FMT \->STR + " " +
  509. DRLON \->FMT \->STR + 4
  510. DISP OBS
  511.           IFERR
  512. OBJ\->
  513.           THEN DROP
  514.           ELSE OBJ\->
  515. DROP SWAP DUP 'n'
  516. STO * 'n3' STO 1 n
  517.             FOR I I
  518. 1 DISP 3 ROLLD 'l'
  519. STO '\Gl' STO \Gl l d \Gh
  520. RMOVE SWAP 180
  521. RANGE SWAP ROT n3
  522. ROLLD n3 ROLLD n3
  523. ROLLD
  524.             NEXT {
  525. n 3 } \->ARRY 'OBS'
  526. STO
  527.           END DRLON
  528. DRLAT d \Gh CCMOVE
  529. 'DRLAT' STO 'DRLON'
  530. STO "New DR: "
  531. DRLAT \->FMT \->STR +
  532. " " + DRLON \->FMT
  533. \->STR + 5 DISP FFIX
  534. 2 FREEZE
  535.         \>> om MENU
  536.       \>> RESTS
  537.     \>>
  538.   SAIL
  539.     \<< SAVES RCLMENU
  540. 28 MENU \-> om
  541.       \<< DEG 0 0 \->
  542. fr\Gl frl
  543.         \<< "From? "
  544. FMT + DRLAT \->FMT
  545. "Lat" \->TAG \->STR "
  546. "
  547. + DRLON \->FMT "Lon"
  548. \->TAG \->STR + { 1 0 }
  549. 'V' 3 \->LIST INPUT
  550. OBJ\-> FMT\-> 'fr\Gl' STO
  551. FMT\-> 'frl' STO
  552. "TO? " FMT + tol
  553. \->FMT "Lat" \->TAG
  554. \->STR "
  555. " + to\Gl \->FMT
  556. "Lon" \->TAG \->STR + {
  557. 1 0 } 'V' 3 \->LIST
  558. INPUT OBJ\-> FMT\->
  559. 'to\Gl' STO FMT\->
  560. 'tol' STO CLLCD 2
  561. FREEZE { { "RHUMB"
  562.           \<< 0 MENU
  563. frl fr\Gl tol to\Gl
  564. RHUMB 0 CONT
  565.           \>> } {
  566. "GC"
  567.           \<< 0 MENU
  568. frl fr\Gl tol to\Gl GC
  569. 0 CONT
  570.           \>> } {
  571. "WAY"
  572.           \<< 0 MENU
  573. "Scale? (nmi)" { ""
  574. V } INPUT OBJ\-> '1_
  575. nmi' DOUNIT 60 /
  576. frl fr\Gl tol to\Gl WAY
  577. 0 CONT
  578.           \>> } {
  579. "VERT"
  580.           \<< 0 MENU
  581. frl fr\Gl tol to\Gl
  582. VERTEX 0 CONT
  583.           \>> } {
  584. "COMP"
  585.           \<< 0 MENU
  586. "Composite" {
  587. ":Lat Limit: 
  588. :Scale: "
  589. { 1 0 } V } INPUT
  590. OBJ\-> '1_nmi' DOUNIT
  591. 60 / SWAP FMT\-> frl
  592. fr\Gl tol to\Gl COMP 0
  593. CONT
  594.           \>> } {
  595. "EXIT"
  596.           \<< 1 CONT
  597.           \>> } }
  598. TMENU
  599.           DO
  600. "Type?" PROMPT 0
  601. MENU
  602.           UNTIL
  603.           END
  604.         \>> om MENU
  605.       \>> RESTS
  606.     \>>
  607.   WVIEW
  608.     \<< 2 FIX { }
  609. SWAP { } 1 1 1 1
  610. "Lat Lon Crs " FMT
  611. + 5 \->LIST DBR
  612.       IF 1 \=/
  613.       THEN DROP2
  614.       ELSE SWAP
  615. DROP SWAP DUP ROT
  616. GET
  617.       END FFIX
  618.     \>>
  619.   ERROR
  620.     \<< SAVES DEG 0 0
  621. 0 0 0 0 0 0 \-> H1 H2
  622. D1 D2 G1 G2 DT DH
  623.       \<< OBS { 1 3 }
  624. GET 'H1' STO OBS {
  625. N 3 } GET 'H2' STO
  626. OBS { 1 2 } GET
  627. 'D1' STO OBS { N 2
  628. } GET 'D2' STO OBS
  629. { 1 1 } GET 'G1'
  630. STO OBS { N 1 } GET
  631. 'G2' STO T2 T1 -
  632. GHA2 GHA1 - / G2 G1
  633. - * 'DT' STO H2 H1
  634. - 'DH' STO 1 DT / N
  635. \v/ / 57.3 H1 H2 + 2
  636. / COS * * 225 D1 D2
  637. + 2 / COS SQ * DH
  638. DT / SQ - \v/ / "ERR"
  639. \->TAG
  640.       \>> RESTS
  641.     \>>
  642.   DRLAT
  643. 37.0204655112
  644.   DRLON
  645. 51.455945662
  646.   CORRECT
  647.     \<< DEG FMT\-> INDX
  648. + HGT \v/ .0293 * -
  649. DUP DUP REFRACT
  650. SWAP COS
  651.       CASE BODY "S"
  652. SAME
  653.         THEN
  654. .002443 * SEMI
  655.         END BODY
  656. "M" SAME
  657.         THEN HP *
  658. HP .272476 *
  659.         END BODY
  660. "VM" SAME
  661.         THEN HP * 0
  662.         END 0 * 0
  663.       END LU * +
  664. SWAP - + \->FMT
  665.     \>>
  666.   RHUMB
  667.     \<< \-> frl fr\Gl tol
  668. to\Gl
  669.       \<< DEG to\Gl fr\Gl
  670. RANGE 'to\Gl' STO 'LN
  671. (TAN(45+tol/2)/TAN(
  672. 45+frl/2))' \->NUM '-
  673. \pi/180*(to\Gl-fr\Gl)'
  674. \->NUM R\->C ARG 180
  675. RANGE DUP \->FMT
  676. "COURSE" \->TAG SWAP
  677.         IF DUP COS
  678. ABS .0001 >
  679.         THEN COS
  680. tol frl - SWAP /
  681.         ELSE to\Gl
  682. fr\Gl - tol frl + 2 /
  683. COS * SWAP SIN /
  684. ABS
  685.         END 60 *
  686. "DIST" \->TAG
  687.       \>>
  688.     \>>
  689.   GC
  690.     \<< \-> frl fr\Gl tol
  691. to\Gl
  692.       \<< DEG 'COS(
  693. frl)*TAN(tol)-SIN(
  694. frl)*COS(to\Gl-fr\Gl)'
  695. \->NUM 'SIN(fr\Gl-to\Gl)'
  696. \->NUM R\->C ARG 180
  697. RANGE \->FMT "COURSE"
  698. \->TAG 'ACOS(SIN(frl)
  699. *SIN(tol)+COS(frl)*
  700. COS(tol)*COS(to\Gl-
  701. fr\Gl))' \->NUM 60 *
  702. "DIST" \->TAG
  703.       \>>
  704.     \>>
  705.   COMP
  706.     \<< 0 0 0 0 0 0 0
  707. 0 \-> scl ll frl fr\Gl
  708. tol to\Gl vl v\Gl fc\Gl
  709. tc\Gl n d d0 sn
  710.       \<< DEG frl fr\Gl
  711. tol to\Gl VERTEX fr\Gl
  712. RANGE 'v\Gl' STO 'vl'
  713. STO to\Gl fr\Gl RANGE
  714. 'tc\Gl' STO
  715.         IF 'vl*SIGN
  716. (ll)\<=ABS(ll)' 'ABS(
  717. v\Gl-(fr\Gl+tc\Gl)/2)>ABS
  718. ((fr\Gl-tc\Gl)/2)AND
  719. ABS(vl)\=/90 AND ABS(
  720. ll-(frl+tol)/2)\>=ABS
  721. ((frl-tol)/2)' OR
  722.         THEN
  723. "GC is OK: Hit ENTER"
  724. MESS
  725.         ELSE DEPTH
  726. 'd0' STO to\Gl fr\Gl
  727. RANGE fr\Gl
  728.           IF <
  729.           THEN 1
  730.           ELSE -1
  731.           END 'sn'
  732. STO
  733.           IFERR ll
  734. TAN INV DUP frl TAN
  735. * ACOS NEG sn * fr\Gl
  736. + 0 RANGE 'fc\Gl' STO
  737. tol TAN * ACOS sn *
  738. to\Gl + 0 RANGE 'tc\Gl'
  739. STO
  740.           THEN
  741. DEPTH d0 - DROPN
  742. "No sol'n: Hit ENTER"
  743. MESS
  744.           ELSE scl
  745. frl fr\Gl ll fc\Gl WAY
  746. DROP 'd' STO+ OBJ\->
  747. 'n' STO
  748.             IF 'RND
  749. (fc\Gl,6)\=/RND(tc\Gl,6)'
  750.             THEN
  751. OBJ\-> SWAP DROP ll
  752. fc\Gl ll tc\Gl RHUMB
  753. 'd' STO+ SWAP \->LIST
  754.             ELSE
  755. DROP -1 'n' STO+
  756.             END scl
  757. ll tc\Gl tol to\Gl WAY
  758. DROP 'd' STO+ OBJ\->
  759. n + \->LIST d "DIST"
  760. \->TAG
  761.           END
  762.         END
  763.       \>>
  764.     \>>
  765.   VERTEX
  766.     \<< 0 \-> frl fr\Gl
  767. tol to\Gl C
  768.       \<< DEG frl fr\Gl
  769. tol to\Gl GC DROP
  770. FMT\-> DUP 'C' STO
  771. DUP SIN frl COS *
  772. ABS ACOS frl 0 \>= 1
  773. -1 IFTE *
  774.         IF DUP 0 ==
  775.         THEN SWAP
  776. DROP 0
  777.         ELSE DUP
  778. ROT COS SWAP SIN /
  779. ASIN NEG
  780.           IF 'C>180
  781. '
  782.           THEN NEG
  783.           END fr\Gl +
  784.           IF 'ABS(
  785. tol)>ABS(frl)AND
  786. SIGN(tol)\=/SIGN(frl)
  787. '
  788.           THEN 180
  789. + SWAP NEG SWAP
  790.           END 0
  791. RANGE
  792.         END \->FMT
  793. "V_Lon" \->TAG SWAP
  794. \->FMT "V_Lat" \->TAG
  795. SWAP
  796.       \>>
  797.     \>>
  798.   WAY
  799.     \<< \-> scl frl fr\Gl
  800. tol to\Gl
  801.       \<< DEG 0 frl
  802. fr\Gl tol to\Gl GC SWAP
  803. DROP 60 / frl fr\Gl
  804. GETV DUP tol to\Gl
  805. GETV CROSS DUP ABS
  806.         IF DUP 0 ==
  807.         THEN DROP2
  808.           IF 'RND(
  809. frl,6)\=/RND(tol,6)OR
  810. RND(fr\Gl,6)\=/RND(to\Gl,
  811. 6)'
  812.           THEN
  813. "Ambiguous Sol'n" 3
  814. DISP
  815.           END 0 fr\Gl
  816. 90 - GETV
  817.         ELSE /
  818.         END NEG 0 0
  819. \-> d gcd r n d0 dsum
  820.         \<< DEPTH
  821. 'd0' STO
  822.           WHILE 'd<
  823. gcd OR d==0'
  824.           REPEAT n
  825. r d SMOVE V\-> ASIN 3
  826. ROLLD R\->C ARG 'd'
  827. scl STO+
  828.           END tol
  829. to\Gl gcd scl / FLOOR
  830. 2 + 'n' STO DUP2
  831. "N/A" ROT \->FMT ROT
  832. \->FMT ROT 3 \->LIST
  833. DEPTH d0 - ROLLD 1
  834. n 1 -
  835.           START 4
  836. DUPN RHUMB 'dsum'
  837. STO+ 3 ROLLD DROP2
  838. 3 ROLLD DUP2 5 ROLL
  839. ROT \->FMT ROT \->FMT
  840. ROT 3 \->LIST DEPTH
  841. d0 - ROLLD
  842.           NEXT
  843. DROP2 n \->LIST dsum
  844. DUP "DIST" \->TAG
  845. SWAP gcd 60 * - '1_
  846. nmi' \->UNIT "ADDD"
  847. \->TAG
  848.         \>>
  849.       \>>
  850.     \>>
  851.   DOUNIT
  852.     \<< -55 CF
  853.       IFERR CONVERT
  854.       THEN DROP
  855.       END UVAL
  856.     \>>
  857.   SD
  858.     \<< 0 \-> x
  859.       \<< DATE DUP
  860. 100 * FP 100 / 1.01
  861. + SWAP DDAYS 183 -
  862. 183 / 'x' STO '(
  863. 15.762145+x*(
  864. -.02513+x*(1.15068+
  865. x*(.02604+x*-.62672
  866. ))))/60' \->NUM
  867.       \>>
  868.     \>>
  869.   RMOVE
  870.     \<< 0 0 0 0 \-> \Gl l
  871. d \Gh d\Gl dl n\Gl nl
  872.       \<< DRLON DRLAT
  873. d \Gh CCMOVE DUP 'nl'
  874. STO DRLAT - 'dl'
  875. STO DUP 'n\Gl' STO
  876. DRLON - 'd\Gl' STO l
  877. \Gl d\Gl + GETV n\Gl 90 +
  878. DUP COS SWAP SIN 0
  879. \->V3 SWAP dl SMOVE
  880. V\-> ASIN 3 ROLLD R\->C
  881. ARG SWAP
  882.       \>>
  883.     \>>
  884.   SMOVE
  885.     \<< \-> n r d
  886.       \<< d COS r * n
  887. n r DOT * 1 d COS -
  888. * + r n CROSS d SIN
  889. * +
  890.       \>>
  891.     \>>
  892.   CCMOVE
  893.     \<< 0 \-> \Gl l d \Gh
  894. l2
  895.       \<< l d \Gh MER l
  896. + DUP 'l2' STO
  897.         IF DUP ABS
  898. 90 \>=
  899.         THEN SIGN
  900. 90 * \Gl SWAP
  901.         ELSE
  902.           IF 'ABS(
  903. COS(\Gh))<.0001'
  904.           THEN '
  905. -.998208257*d*SIN(\Gh
  906. )/COS((l+l2)/2)*\v/(1
  907. -(ee*SIN((l+l2)/2))
  908. ^2)' \->NUM
  909.           ELSE l l2
  910. \Gh DLo
  911.           END \Gl +
  912. SWAP
  913.         END
  914.       \>>
  915.     \>>
  916.   MER
  917.     \<< \-> l1 d \Gh
  918.       \<< '
  919. .998208256722/(1-ee
  920. ^2)*\.S(l1,l1+d*COS(\Gh
  921. ),(1-(ee*SIN(l))^2)
  922. ^1.5,l)' \->NUM
  923.       \>>
  924.     \>>
  925.   DLo
  926.     \<< 0 0 \-> l1 l2 \Gh
  927. sl1 sl2
  928.       \<< l1 SIN
  929. 'sl1' STO l2 SIN
  930. 'sl2' STO '
  931. -57.2957795131*TAN(
  932. \Gh)*(ATANH((sl2-sl1)
  933. /(1-sl1*sl2))-ee*
  934. ATANH(ee*(sl2-sl1)/
  935. (1-ee^2*sl2*sl1)))'
  936. \->NUM
  937.       \>>
  938.     \>>
  939.   GETV
  940.     \<< \-> l \Gl
  941.       \<< l COS \Gl COS
  942. * l COS \Gl SIN * l
  943. SIN \->V3
  944.       \>>
  945.     \>>
  946.   ee
  947. 8.18188106628E-2
  948.   FMT "(dd.mmt)"
  949.   FFMT 1
  950.   FFIX
  951.     \<<
  952.       IF 'FFMT==1'
  953.       THEN 3 FIX
  954.       ELSE 4 FIX
  955.       END
  956.     \>>
  957.   FMT\->
  958.     \<<
  959.       CASE 'FFMT==1
  960. '
  961.         THEN HMT\->
  962.         END 'FFMT==
  963. 0'
  964.         THEN HMS\->
  965.         END
  966.       END
  967.     \>>
  968.   \->FMT
  969.     \<<
  970.       CASE 'FFMT==1
  971. '
  972.         THEN \->HMT
  973.         END 'FFMT==
  974. 0'
  975.         THEN \->HMS
  976.         END
  977.       END
  978.     \>>
  979.   \->HMT
  980.     \<< 4 RND DUP IP
  981. SWAP FP .6 * +
  982.     \>>
  983.   HMT\->
  984.     \<< DUP IP SWAP
  985. FP 1.66666667 * +
  986.     \>>
  987.   SVSTK {
  988. # 81388003E00FF4h
  989. # 0h }
  990.   RESTS
  991.     \<< SVSTK STOF
  992. FFIX
  993.     \>>
  994.   SAVES
  995.     \<< RCLF 'SVSTK'
  996. STO -20 CF -21 CF
  997. -22 SF -55 CF
  998.     \>>
  999.   \GmST
  1000.     \<< 0 0 0 \-> s2 s3
  1001. s4
  1002.       \<< 2 SK 's2'
  1003. STO 3 SK 's3' STO 4
  1004. SK 's4' STO '(-s3+\v/
  1005. (s3^2-3*s4*(s2-1)))
  1006. /(3*s4)' \->NUM RE
  1007. UBND MIN
  1008.       \>>
  1009.     \>>
  1010.   UBND
  1011.     \<< \Ga1 \Gb1 ABS -
  1012. \Ga2 \Gb2 ABS - \Ga3 \Gb3
  1013. ABS - MIN MIN
  1014.     \>>
  1015.   LBND
  1016.     \<< \Ga1
  1017. 1.73205080757 \Gb1
  1018. ABS * - \Ga2
  1019. 1.73205080757 \Gb2
  1020. ABS * - \Ga3
  1021. 1.73205080757 \Gb3
  1022. ABS * - MIN MIN
  1023.     \>>
  1024.   SK
  1025.     \<< \-> k
  1026.       \<< '\Gb1^2/\Ga1^k+
  1027. \Gb2^2/\Ga2^k+\Gb3^2/\Ga3^k
  1028. ' \->NUM
  1029.       \>>
  1030.     \>>
  1031.   G\Gm
  1032.     \<< \Gb1 \Ga1 \Gm - /
  1033. SQ \Gb2 \Ga2 \Gm - / SQ +
  1034. \Gb3 \Ga3 \Gm - / SQ + 1
  1035. -
  1036.     \>>
  1037.   ASK
  1038.     \<< { "YES" "" ""
  1039. "" "" "NO" } TMENU
  1040. 0
  1041.       DO DROP -1
  1042. WAIT
  1043.       UNTIL DUP {
  1044. 11.1 16.1 } SWAP
  1045. POS DUP
  1046.         IF NOT
  1047.         THEN 880 .1
  1048. BEEP
  1049.         END
  1050.       END 0 MENU
  1051.     \>>
  1052.   MLIMB { { "LL"
  1053.     \<< 1 CONT
  1054.     \>> } "" { "UL"
  1055.     \<< -1 CONT
  1056.     \>> } "" { "CENT"
  1057.     \<< 0 CONT
  1058.     \>> } "" }
  1059.   MBODY { { "SUN"
  1060.     \<< "S" CONT
  1061.     \>> } { "MOON"
  1062.     \<< "M" CONT
  1063.     \>> } { "VENUS"
  1064.     \<< "VM" CONT
  1065.     \>> } { "MARS"
  1066.     \<< "VM" CONT
  1067.     \>> } { "PLANET"
  1068.     \<< "P" CONT
  1069.     \>> } { "STAR"
  1070.     \<< "T" CONT
  1071.     \>> } }
  1072.   PSCALE
  1073.     \<< \-> s a
  1074.       \<<
  1075.         IF 's\=/0'
  1076.         THEN 'a/(
  1077. 360+a/s)' \->NUM
  1078.         ELSE 0
  1079.         END
  1080.       \>>
  1081.     \>>
  1082.   tol 10
  1083.   to\Gl 10
  1084.   LON 89.7214000014
  1085.   LAT 10.5730000011
  1086.   IERR
  1087. 1.6606266327E-3
  1088.   LIMIT
  1089.     \<< 0 0 0 0 0 0 \->
  1090. g1 g2 d1 d2 d180 up
  1091.       \<< DUP2 C\->R
  1092. 'd1' STO 'g1' STO
  1093. C\->R 'd2' STO 'g2'
  1094. STO
  1095.         IF 'ABS(g1-
  1096. g2)>180'
  1097.         THEN DROP2
  1098. LON 180
  1099.           IF 'g1>
  1100. LON'
  1101.           THEN +
  1102.           ELSE -
  1103.           END 'up'
  1104. STO 'd1+(up-g1)*(d1
  1105. -d2)/(g1-g2)' \->NUM
  1106. 'd180' STO g2 d2
  1107. R\->C up 360
  1108.           IF 'up>
  1109. LON'
  1110.           THEN -
  1111.           ELSE +
  1112.           END d180
  1113. R\->C up d180 R\->C g1
  1114. d1 R\->C LINE
  1115.         END
  1116.       \>>
  1117.     \>>
  1118.   RANGE
  1119.     \<< \-> \Gl
  1120.       \<<
  1121.         WHILE DUP
  1122. 180 \Gl + >
  1123.         REPEAT 360
  1124. -
  1125.         END
  1126.         WHILE DUP
  1127. -180 \Gl + <
  1128.         REPEAT 360
  1129. +
  1130.         END
  1131.       \>>
  1132.     \>>
  1133.   LOP
  1134.     \<< \-> g d a l
  1135.       \<<
  1136.         IF 'ABS(l)\=/
  1137. 90'
  1138.         THEN 'g+
  1139. ACOS((SIN(a)-SIN(l)
  1140. *SIN(d))/(COS(l)*
  1141. COS(d)))' \->NUM
  1142.         ELSE g
  1143.         END DUP IM
  1144.         IF 0 \=/
  1145.         THEN DROP g
  1146.         END
  1147.         IF 'ABS(l)>
  1148. 90-ABS(d)+a'
  1149.         THEN 180 +
  1150.         END LON
  1151. RANGE l R\->C
  1152.       \>>
  1153.     \>>
  1154.   CST { SOLVE ADDOB
  1155. SETUP INIT ADV
  1156. ADDDR DR PLOTP SAIL
  1157. WVIEW ERROR TIME }
  1158.   REFRACT
  1159.     \<< 0 \-> h rp
  1160.       \<< '1/TAN(h+
  1161. 7.31/(h+4.4))' \->NUM
  1162. 'rp' STO 'rp*((
  1163. PRESS-80)/930)/(1+
  1164. .00008*(rp+39)*(
  1165. TMPTR-10))' \->NUM 60
  1166. /
  1167.       \>>
  1168.     \>>
  1169.   MESS
  1170.     \<< 3 DISP 7
  1171. FREEZE 0 WAIT DROP
  1172.     \>>
  1173.   PPAR {
  1174. (90.5890052687,10.1563333344)
  1175. (88.8537947341,10.9896666678)
  1176. X 0 (0,0) FUNCTION
  1177. Y }
  1178.   T\Gg 6
  1179.   G\Gg 231.103333334
  1180.   PRESS 1010
  1181.   TMPTR 10
  1182.   a0 '-(G12*G23-G13
  1183. *G22)*G13+(G11*G23-
  1184. G12*G13)*G23-(G11*
  1185. G22-G12^2)*G33'
  1186.   a1 'G11*G22-G12^2
  1187. +G11*G33-G13^2+G22*
  1188. G33-G23^2'
  1189.   TF 213.112966667
  1190.   CRS 320
  1191.   SPD 0
  1192.   EV3 '-2*\v/Q*COS((\Gh
  1193. +360)/3)+N/3'
  1194.   EV2 'N-\Ga1-\Ga3'
  1195.   EV1 '-2*\v/Q*COS(\Gh/
  1196. 3)+N/3'
  1197.   \Gm -.178280167539
  1198.   \Gb3 2.75456498847
  1199.   \Gb2
  1200. 4.61233514353E-2
  1201.   \Gb1
  1202. 1.14190212639E-2
  1203.   E3
  1204. [ .338319152137 .168945881156 .925741562499 ]
  1205.   E2
  1206. [ .676618904731 .64002613719 -.364078839641 ]
  1207.   E1
  1208. [ -.65400841667 .749549086407 .102221123028 ]
  1209.   INTERP
  1210.     \<< \-> T V1 V2
  1211.       \<< V1 V2 V1 -
  1212. T2 T1 - / T T1 - *
  1213. +
  1214.       \>>
  1215.     \>>
  1216.   GSUM
  1217.     \<< \-> DS DC GS GC
  1218. HS
  1219.       \<< 0 'G11' STO
  1220. 0 'G12' STO 0 'G13'
  1221. STO 0 'G22' STO 0
  1222. 'G23' STO { 3 } 0
  1223. CON 'R' STO OBS
  1224. OBJ\-> OBJ\-> DROP DROP
  1225. 'N' STO 1 N
  1226.         START SIN
  1227. 'HS' STO DUP SIN
  1228. 'DS' STO COS 'DC'
  1229. STO DUP SIN 'GS'
  1230. STO COS 'GC' STO DS
  1231. SQ 'G11' STO+ DS DC
  1232. GC * * 'G12' STO+
  1233. DS DC GS * * 'G13'
  1234. STO+ DC SQ GC SQ *
  1235. 'G22' STO+ DC SQ GS
  1236. GC * * 'G23' STO+ R
  1237. OBJ\-> DROP DC GS HS
  1238. * * + ROT DS HS * +
  1239. ROT DC GC HS * * +
  1240. ROT { 3 } \->ARRY 'R'
  1241. STO
  1242.         NEXT N G11
  1243. G22 + - 'G33' STO
  1244.       \>>
  1245.     \>>
  1246.   OUT
  1247.     \<< OBJ\-> DROP \-> U
  1248. V W
  1249.       \<<
  1250.         IF 'ABS(U)>
  1251. 1'
  1252.         THEN U SIGN
  1253. 'U' STO
  1254.         END U ASIN
  1255. V W R\->C ARG \->FMT
  1256. "LON" \->TAG SWAP
  1257. \->FMT "LAT" \->TAG
  1258.       \>>
  1259.     \>>
  1260.   UVW
  1261.     \<< \Gb1 \Ga1 \Gm - /
  1262. E1 * \Gb2 \Ga2 \Gm - / E2
  1263. * \Gb3 \Ga3 \Gm - / E3 *
  1264. + +
  1265.     \>>
  1266.   EIGEN
  1267.     \<< \-> EV
  1268.       \<< 'G12*G23-
  1269. G13*G22+G13*EV'
  1270. \->NUM 'G13*G12-G11*
  1271. G23+G23*EV' \->NUM '
  1272. G11*G22-SQ(G12)-(
  1273. G11+G22)*EV+SQ(EV)'
  1274. \->NUM { 3 } \->ARRY
  1275. DUP ABS
  1276.         IF DUP 0 \=/
  1277.         THEN /
  1278.         ELSE DROP
  1279.         END
  1280.       \>>
  1281.     \>>
  1282.   \Ga2 .38067798101
  1283.   \Ga3 2.58992744633
  1284.   \Ga1 .029394572665
  1285.   \Gh 'ACOS(R1/Q^1.5)
  1286. '
  1287.   R1 'A0/2+N/3*(A1/
  1288. 6-Q)'
  1289.   Q '(N/3)^2-A1/3'
  1290.   N 3
  1291.   A0
  1292. -2.89809425646E-2
  1293.   A1 1.07324802832
  1294.   G33 2.27032850246
  1295.   R
  1296. [ .955661886936 .50345167658 2.53439002533 ]
  1297.   G23 .318611864541
  1298.   G22 .246376558567
  1299.   G13 .715412834112
  1300.   G12 .298478592826
  1301.   G11 .483294938977
  1302.   GHA2
  1303. 60.5550000011
  1304.   DEC2
  1305. 22.0816666668
  1306.   T2 12
  1307.   GHA1
  1308. 45.5566666678
  1309.   DEC1
  1310. 22.0750000002
  1311.   T1 11
  1312.   LU 1
  1313.   SEMI .26333333386
  1314.   HP .9333333352
  1315.   HGT 3.048
  1316.   INDX 0
  1317.   BODY "S"
  1318. END
  1319.